home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / scheme / pcscheme / geneva / sources.exe / SOURCES / ASM / SCHEME.ASM < prev    next >
Encoding:
Assembly Source File  |  1993-09-30  |  16.1 KB  |  483 lines
  1. ;* SCHEME.ASM
  2. ;************************************************************************
  3. ;*                                    *
  4. ;*        PC Scheme/Geneva 4.00 Borland TASM code            *
  5. ;*                                    *
  6. ;* (c) 1985-1988 by Texas Instruments, Inc. See COPYRIGHT.TXT        *
  7. ;* (c) 1992 by L. Bartholdi & M. Vuilleumier, University of Geneva    *
  8. ;*                                    *
  9. ;*----------------------------------------------------------------------*
  10. ;*                                    *
  11. ;*        Many init-time scheme objects (no code)            *
  12. ;*                                    *
  13. ;*----------------------------------------------------------------------*
  14. ;*                                    *
  15. ;* Created by: John Jensen        Date: 1985            *
  16. ;* Revision history:                            *
  17. ;* - 26 Feb 86:    Modified the initial value of the global variable    *
  18. ;*    "listpage" so that it points to page zero (0) instead of    *
  19. ;*    END_LIST. This causes it to always point to a valid page,    *
  20. ;*    thus eliminating one check for each CONS operation. (JCJ)    *
  21. ;* - 22 May 86:    changed debug flag in R2 used as VM starts up;        *
  22. ;*    if none, R2=0 (nil), else R2=tagged fixnum zero (rb)        *
  23. ;* - 10 Feb 87:    Changed page 5 special symbols to for #T instead of    *
  24. ;*    #!TRUE for the R^3 Report. (tc)                    *
  25. ;* - 18 Jun 92:    Renaissance (Borland Compilers, ...)            *
  26. ;*                                    *
  27. ;*                    ``In nomine omnipotentii dei''    *
  28. ;************************************************************************
  29. IDEAL
  30. %PAGESIZE    60, 132
  31. MODEL    medium
  32. LOCALS    @@
  33.  
  34.     INCLUDE    "scheme.ash"
  35.     INCLUDE "assembly.ash"
  36.  
  37. DATASEG
  38.  
  39. ; Page Table - This area of memory holds the table of base
  40. ;        (paragraph) addresses for each of the page
  41. ;        frames in Scheme's memory system.
  42. MONKEY    = $
  43. pagetable DW    NUMPAGES dup (?)
  44. ORG    MONKEY
  45.     DW    NILPAGE            ; page 0 - 'nil or cdr nil
  46.     DW    0             ; page 1 - characters (immediates)
  47.     DW    0             ; page 2 - forwarded pointer
  48.     DW    0             ; page 3 - 15-bit fixnums (immediates)
  49.     DW    FLTPAGE            ; page 4 - special 32-bit flonums
  50.     DW    SMBPAGE            ; page 5 - special symbols
  51.     DW    PRTPAGE            ; page 6 - standard port page
  52.     DW    CODPAGE            ; page 7 - code for test programs
  53.     DW    NVTPAGE            ; page 8 - initial environments
  54.                     ; remainder of page table
  55.     DW    NUMPAGES-PREALLOC dup (0)
  56.  
  57. ; Page Attribute Table - The bits in the following table are
  58. ;        used to indicate the state of each of the pages
  59. ;        in the Scheme memory system.  Only one kind of data
  60. ;        object can be stored in a given page, so a single bit
  61. ;        can be used to classify all references to a page.
  62.  
  63. MONKEY    = $
  64. attrib    DW    NUMPAGES dup (?)
  65. ORG    MONKEY
  66.     DW    ATOM+READONLY
  67.     DW    ATOM+CHARS+READONLY+NOMEMORY
  68.     DW    NOMEMORY
  69.     DW    ATOM+FIXNUMS+READONLY+NOMEMORY
  70.     DW    ATOM+FLONUMS+READONLY
  71.     DW    ATOM+SYMBOLS+READONLY
  72.     DW    ATOM+PORTS+READONLY
  73.     DW    ATOM+CODE
  74.     DW    ATOM             ; Initial Environments
  75.     DW    NUMPAGES-PREALLOC dup (NOMEMORY)
  76.  
  77. ; Next available location table - The following table contains
  78. ;        the offsets of the next available location which
  79. ;        may be allocated in each page.  A negative value
  80. ;        indicates that the page is full and that no further
  81. ;        allocation is possible within a page.
  82.  
  83. MONKEY    = $
  84. nextcell DW    NUMPAGES dup (?)
  85. ORG    MONKEY
  86.     DW    DEDPAGES dup (END_LIST)
  87.     DW    NVTPAGE:env_nxt     ; Environments page
  88.     DW    NUMPAGES-PREALLOC dup (END_LIST)
  89.  
  90. ; Page link table - Pages which contain data objects of the same
  91. ;        type are linked together via the following table.
  92.  
  93. pagelink DW    NUMPAGES dup (END_LIST)
  94.  
  95. ; Page type table - This table holds the "type" of each page for
  96. ;        pointer classification purposes.  The values in
  97. ;        this table may be used as indicies into branch
  98. ;        tables.
  99.  
  100. MONKEY    = $
  101. ptype    DB    NUMPAGES dup (?)
  102. ORG    MONKEY
  103.     DW    LISTTYPE         ; Page 0 contains list cells
  104.     DW    CHARTYPE         ; Page 1 is for character immediates
  105.     DW    FREETYPE         ; Page 2 is for "forwarded pointers"
  106.     DW    FIXTYPE         ; Page 3 is for fixnum immediates
  107.     DW    FLOTYPE         ; Page 4 contains pre-defined flonums
  108.     DW    SYMBTYPE         ; Page 5 contains pre-defined symbols
  109.     DW    PORTTYPE         ; Page 6 contains standard I/O ports
  110.     DW    CODETYPE         ; Page 7 contains test programs
  111.     DW    ENVTYPE         ; Page 8 contains environments
  112.     DW    NUMPAGES-PREALLOC dup (FREETYPE) ; Rest of pages not pre-allocated
  113.  
  114. MONKEY    = $
  115. psize    DW    NUMPAGES dup (?)
  116. ORG    MONKEY
  117.     DW    NILPAGESIZE        ; Page 0 contains special list cells
  118.     DW    0             ; Page 1 is a tag for immediate characters
  119.     DW    0             ; Page 2 reserved for "forwarded pointers"
  120.     DW    0             ; Page 3 is a tag used for immediate fixnums
  121.     DW    FLTPAGESIZE        ; Page 4 contains pre-defined flonums
  122.     DW    SMBPAGESIZE        ; Page 5 contains pre-defined symbols
  123.     DW    PRTPAGESIZE        ; Page 6 contains standard I/O ports
  124.     DW    CODPAGESIZE         ; Page 7 contains test programs
  125.     DW    NVTPAGESIZE         ; Page 8 contains environments
  126.     DW    NUMPAGES-PREALLOC dup (MIN_PAGESIZE) ; Initialize default page size
  127.  
  128. ; Table of pages for allocation by type
  129.  
  130. MONKEY    = $
  131. pagelist DW    NUMTYPES dup (?)
  132. ORG    MONKEY
  133. listpage DW    0             ; [0] Page number for list cell allocation
  134. fixpage    DW    END_LIST         ; [1] Page number for fixnum allocation
  135. flopage    DW    END_LIST         ; [2] Page number for flonum allocation
  136. bigpage    DW    END_LIST         ; [3] Page number for bignum allocation
  137. sympage    DW    END_LIST         ; [4] Page number for symbol allocation
  138. stpage    DW    END_LIST         ; [5] Page number for string allocation
  139. vectpage DW    END_LIST         ; [6] Page number for vector allocation
  140. contpage DW    END_LIST         ; [7] Page number for continuation allocation
  141. clospage DW    END_LIST         ; [8] Page number for closure allocation
  142. freepage DW    END_LIST         ; [9] Free page list header
  143. codepage DW    END_LIST         ; [10] Page number for code block allocation
  144. i86page    DW    END_LIST         ; [11] Page number for inline code allocation
  145. portpage DW    END_LIST         ; [12] Page number for port allocation
  146. chapage DW    END_LIST         ; [13] Page number for characters
  147. envpage    DW    ENV_PAGE         ; [14] Page for environments
  148.  
  149. ; Table of page attributes by data object type
  150. MONKEY    = $
  151. pageattr DW    NUMTYPES dup (?)
  152. ORG    MONKEY
  153.     DW    LISTCELL         ; [0] List cell attributes
  154.     DW    ATOM+FIXNUMS         ; [1] Fixnum attributes
  155.     DW    ATOM+FLONUMS         ; [2] Flonum attributes
  156.     DW    ATOM+BIGNUMS         ; [3] Bignum attributes
  157.     DW    ATOM+SYMBOLS         ; [4] Symbol attributes
  158.     DW    ATOM+STRINGS         ; [5] String attributes
  159.     DW    ATOM+VECTORS         ; [6] Vector (array) attributes
  160.     DW    ATOM+CONTINU         ; [7] Continuation attributes
  161.     DW    ATOM+CLOSURE         ; [8] Closure attributes
  162.     DW    0             ; [9] Free page has no attributes
  163.     DW    ATOM+CODE         ; [10] Code block attributes
  164.     DW    ATOM+I86CODE         ; [11] Inline 8086 code attributes
  165.     DW    ATOM+PORTS         ; [12] Port attributes
  166.     DW    ATOM+CHARS         ; [13] Character attributes
  167.     DW    ATOM             ; [14] Environment attributes
  168.  
  169. nextpage DW    PREALLOC        ; Next unused page number
  170. lastpage DW    PREALLOC        ; Will hold last page #
  171. nextpara DW    0             ; Next available paragraph number
  172. PAGESIZE DW    MIN_PAGESIZE
  173.  
  174. ; "Registers" for the Scheme Virtual Machine
  175.  
  176. MONKEY    = $
  177. regs    REG    NUM_REGS dup (?)
  178. ORG    MONKEY
  179. reg0    REG    < NIL_DISP, NIL_PAGE*2 >; Virtual register 0 - always nil
  180. LABEL    reg1    REG
  181.     REG    NUM_REGS-1 dup (< UN_DISP, UN_PAGE*2 >)
  182.  
  183. tmp_adr    DW    tmp_reg            ; addresses of temporary registers
  184. tm2_adr    DW    tm2_reg
  185.  
  186. s_pc    DW    CODPAGE:entry
  187.  
  188. ; Storage for oblist hash table
  189. hash_page    DB    HT_SIZE dup (0)
  190. hash_disp    DW    HT_SIZE dup (0)
  191.  
  192. ; Storage for property list hash table
  193. prop_page    DB    HT_SIZE dup (0)
  194. prop_disp    DW    HT_SIZE dup (0)
  195.  
  196. obj_hlist    POINTER <0, 0>        ; object hashing
  197.  
  198. ; Stack storage (stack buffer)
  199. LABEL    s_stack    STKFDEF
  200.     POINTER    < NIL_PAGE*2, NIL_DISP >; caller's code base pointer
  201.     POINTER    < SPECFIX*2, 0 >     ; return address displacement
  202.     POINTER    < SPECFIX*2, 0 >     ; caller's frame pointer
  203.     POINTER    < ENV_PAGE*2, NVTPAGE:g_env >; current heap environment
  204.     POINTER    < SPECFIX*2, 0 >    ; static link
  205.     POINTER    < NIL_PAGE*2, NIL_DISP >; closure pointer ('nil means open call)
  206. STK_HEAD = $-s_stack
  207.     DB    STKSIZE-STK_HEAD dup (0)
  208.  
  209. topofstack DW    STK_HEAD-SIZE POINTER     ; current top-of-stack pointer
  210. frameptr DW    0             ; current stack frame pointer
  211. base    DW    0             ; stack buffer base
  212.  
  213. ; State variables for (reset) and (scheme-reset)
  214. fp_save    DW    0             ; save area for nominal stack
  215. rst_ent    DW    reset_x             ; entry point for reset code
  216. err_ent    DW    err_rtn             ; entry point for error handler invocation
  217.  
  218. ; Flags for VM Control
  219. vm_debug DW    0             ; flag indicating VM_debug mode
  220. s_break    DB    0             ; flag indicating shift-break key depressed
  221.  
  222. ; Special storage for nil
  223. SEGMENT    NILPAGE    PARA    PUBLIC    'FAR_DATA'
  224.     POINTER < NIL_PAGE*2, NIL_DISP >; Special constant:  (cons nil nil)
  225.     POINTER    < NIL_PAGE*2, NIL_DISP >
  226. NILPAGESIZE =    $             ; end of Page 0
  227. ENDS    NILPAGE
  228.  
  229. ; Special 64-bit floating point constants area
  230. SEGMENT    FLTPAGE    PARA    PUBLIC    'FAR_DATA'
  231. P8087
  232.     FLODEF    { data = -1.0 }
  233.     FLODEF    { data = 0.0 }
  234.     FLODEF    { data = 1.0 }
  235. FLTPAGESIZE =    $             ; end of Page 4
  236. ENDS    FLTPAGE
  237.  
  238. ; Define symbol constant
  239. MACRO    symbol    str
  240.     local    first, last
  241. first    DB    SYMBTYPE         ; tag
  242.     DW    last-first        ; length field
  243.     POINTER    < NIL_PAGE*2, NIL_DISP >; link field page number - initially null
  244.     DB    0             ; hash key - 0 for "special symbols"
  245.     DB    str             ; character data
  246. last    =    $
  247. ENDM
  248.  
  249. ; Special storage for single character symbols
  250. SEGMENT    SMBPAGE    PARA    PUBLIC    'FAR_DATA'
  251. LABEL    t_symbol    unknown
  252.     symbol    "#T"            ; #T for #!true for 't for true
  253.     symbol    "#!UNASSIGNED"        ; the proverbial undefined value
  254.     symbol    "#!NOT-A-NUMBER"    ; undefined result of arithmetic
  255. LABEL    eof_sym    unknown
  256.     symbol    "#!EOF"            ; end-of-file indicator
  257. LABEL    non_prt    unknown
  258.     symbol    "#!UNPRINTABLE"        ; value of *the-non-printing-object*
  259. SMBPAGESIZE =    $            ; end of Page 5
  260. ENDS    SMBPAGE
  261.  
  262. SEGMENT    PRTPAGE    PARA    PUBLIC    'FAR_DATA'
  263. ; Standard Input Port
  264. stdinp    DB    PORTTYPE         ; tag=PORT
  265.     DW    stdinp_-stdinp         ; length of object in BYTEs
  266.     POINTER    < NIL_PAGE*2, NIL_DISP >; null pointer
  267.     DW    01001111b        ; flags (binary, window, read & write)
  268.     DW    0             ; handle (stdin CON)
  269.     DW    0             ; cursor line
  270.     DW    0             ; cursor column
  271.     DW    0             ; upper left line
  272.     DW    0             ; upper left column
  273.     DW    0            ; number of lines
  274.     DW    0            ; number of columns
  275.     DW    -1             ; border attributes (none)
  276.     DW    000FH             ; text attributes (white, enable)
  277.     DW    00000011b        ; window flags (transcript, wrap)
  278.     DW    0             ; current buffer position
  279.     DW    0             ; current end of buffer
  280.     DB    BUFFSIZE dup (0)     ; input buffer
  281.     POINTER    < NIL_PAGE*2, NIL_DISP >; no pointer to next window
  282. stdinp_    =    $
  283.  
  284. ;   The following point object is now used for the pcs-status-window
  285. stdoutp    DB    PORTTYPE         ; tag=PORT
  286.     DW    stdoutp_-stdoutp     ; length of object in BYTEs
  287.     POINTER    < NIL_PAGE*2, NIL_DISP >; null pointer
  288.     DW    01001111b        ; flags (binary, window, read & write)
  289.     DW    1             ; handle (stdout CON)
  290.     DW    0             ; cursor line
  291.     DW    0             ; cursor column
  292.     DW    0            ; upper left line
  293.     DW    0             ; upper left column
  294.     DW    1             ; number of lines
  295.     DW    0            ; number of columns
  296.     DW    -1             ; border attributes (none)
  297.     DW    001CH             ; text attrs (reverse video, green, enable)
  298.     DW    00000001b        ; window flags (no transcript, wrap)
  299.     DW    0             ; current buffer position
  300.     DW    0             ; current end of buffer
  301.     DB    BUFFSIZE dup (0)     ; output buffer
  302.     POINTER    < SPECPOR*2, 0 >    ; pointer to previously defined window
  303. stdoutp_ =    $
  304. PRTPAGESIZE =    $             ; end of Page 6
  305. ENDS    PRTPAGE
  306.  
  307. ; Environments
  308. SEGMENT    NVTPAGE    PARA    PUBLIC    'FAR_DATA'
  309. ENV_PAGE =    8
  310. ; define USER-GLOBAL-ENVIRONMENT
  311. LABEL    g_env    ENVDEF
  312.     DB    ENVTYPE
  313.     DW    g_env_-g_env
  314.     POINTER    < NIL_PAGE*2, NIL_DISP >; parent pointer (there is no parent)
  315.     POINTER    HT_SIZE dup (< NIL_PAGE*2, NIL_DISP >)
  316. g_env_ = $
  317.  
  318. ; define USER-INITIAL-ENVIRONMENT
  319. LABEL    u_env    ENVDEF
  320.     DB    ENVTYPE
  321.     DW    u_env_-u_env
  322.     POINTER    < ENV_PAGE*2, g_env >
  323.     POINTER    HT_SIZE dup (< NIL_PAGE*2, NIL_DISP >)
  324. u_env_ = $
  325.  
  326. ;define PCS-RESERVED-SYMBOLS-ENVIRONMENT (factice environment, link to prop list)
  327. LABEL    r_env    ENVDEF
  328.     DB    ENVTYPE
  329.     DW    r_env_-r_env
  330.     POINTER    < ENV_PAGE*2, g_env >
  331.     POINTER    2 dup (< NIL_PAGE*2, NIL_DISP >)
  332. r_env_ = $
  333.  
  334. LABEL    env_nxt    ENVDEF
  335. NVTPAGESIZE = env_nxt+(1*SIZE ENVDEF)    ; allow room for 1 environment
  336.     DB    FREETYPE
  337.     DW    NVTPAGESIZE-env_nxt
  338.     DB    NVTPAGESIZE-$ dup (0)
  339. ENDS    NVTPAGE
  340.  
  341. ; Assembly area for test programs
  342. SEGMENT    CODPAGE    PARA    PUBLIC    'FAR_DATA'
  343.     DB    CODETYPE         ; Block header
  344.     DW    CODPAGESIZE
  345.     FIXNUM    <, entry >         ; Code starting offset
  346. ;     Constant (pointers) go here
  347. s_top_level =    0
  348.     POINTER    < NIL_PAGE*2, NIL_DISP >; "scheme-top-level" symbol goes here
  349. CREAD    =    1
  350.     POINTER    < NIL_PAGE*2, NIL_DISP >; "read" symbol goes here
  351. CEOF    =    2
  352.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "eof" symbol goes here
  353. CINP    =    3
  354.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "input-port" symbol goes here
  355. COUTP    =    4
  356.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "output-port" symbol goes here
  357. CCONS    =    5
  358.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "console" symbol goes here
  359. CNO_PRT    =    6
  360.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "*the-non-printing-object*" sym
  361. CUGENV    =    7
  362.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "user-global-environment" sym
  363. CUIENV    =    8
  364.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "user-initial-environment" sym
  365. CRSENV    =    9
  366.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "pcs-reserved-symbols-environment" sym
  367. err_name =    10
  368.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "*error-handler*" symbol
  369. CWHO    =    11
  370.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "pcs-status-window"
  371. kill_engine =    12
  372.     POINTER    < NIL_PAGE*2, NIL_DISP >; interned "PCS-KILL-ENGINE"
  373. CEOFX    =    13
  374.     POINTER    < SPECSYM*2, SMBPAGE:eof_sym >; special non-interned "eof" symbol
  375. CNO_PRTX =    14
  376.     POINTER < SPECSYM*2, SMBPAGE:non_prt >; special non-interned "#!unprintable" sym
  377. CUGENVX    =    15
  378.     POINTER    < ENV_PAGE*2, NVTPAGE:g_env >; pointer to user-global-environment
  379. CUIENVX    =    16
  380.     POINTER    < ENV_PAGE*2, NVTPAGE:u_env >; pointer to user-initial-environment
  381. CRSENVX    =    17
  382.     POINTER    < ENV_PAGE*2, NVTPAGE:r_env >; pointer to pcs-reserved-symbols-environment
  383. CWHOX    =    18
  384.     POINTER    < SPECPOR*2, PRTPAGE:stdoutp >; pointer to "who-line" window object
  385. LABEL    entry
  386.     VM_NUM?    R2                  ; second input argument 0 specified?
  387.     VM_JNLs    R2, no_debug         ; if not, don't begin debug (jump)
  388.     VM_DBG                ; initiate debug mode
  389. LABEL    no_debug
  390.  
  391.     VM_MVC    R63, CEOFX        ; define "eof"
  392.     VM_DEF    R63, CEOF
  393.     VM_MVC    R63, CNO_PRTX        ; define "*the-non-printing-object*" to "#!unprintable"
  394.     VM_DEF    R63, CNO_PRT
  395.     VM_MVC    R63, CUGENVX        ; define "user-global-environment" to point to said
  396.     VM_DEF    R63, CUGENV
  397.     VM_MVC    R63, CUIENVX        ; define "user-initial-environment" to point to said
  398.     VM_DEF    R63, CUIENV
  399.     VM_MVC    R63, CRSENVX        ; define "pcs-reserved-symbols-environment" to point to said
  400.     VM_DEF    R63, CRSENV
  401.     VM_MVC    R63, CWHOX        ; define "who-line"
  402.     VM_DEF    R63, CWHO
  403.     VM_MVC    R63, CCONS        ; fluid-bind "input-port", "output-port" to 'console
  404.     VM_BIND    CINP, R63
  405.     VM_BIND    COUTP, R63
  406.     VM_BIND s_top_level, R0        ; fluid-bind "scheme-top-level" to nil
  407.     VM_MVC    R63, err_name        ; establish the default error handler
  408.     VM_CLO    R63, err_default, 0
  409.     VM_DEF    R63, err_name
  410.     VM_MVC    R63, kill_engine    ; establish the default PCS-KILL-ENGINE
  411.     VM_CLO    R63, ret_default, 0
  412.     VM_DEF    R63, kill_engine
  413.                     ; check the input parameter to see if it's a filename
  414.     VM_FASL    R1             ; fast load first program unit
  415. LABEL    next_rd
  416.     VM_MOV    R8, R0
  417.     VM_FASL    R8
  418.     VM_MVC    R9, CEOFX
  419.     VM_JEQs    R9, R8, end_rd
  420.     VM_PUSH    R8             ; save program just read
  421.     VM_EXEC    R1             ; execute the previously read program
  422.     VM_POP    R1             ; restore pointer to most recently read pgm
  423.     VM_JMPs    next_rd         ; see if more procedures follow
  424. LABEL    end_rd
  425.     VM_EXEC    R1             ; Load program-Create the closure
  426.     VM_MOV    R2, R1             ; Copy returned value to R2
  427.     VM_SYM?    R2             ; Was a symbol returned?
  428.     VM_JNLs    R2, not_sym         ; If not, don't try to look it up
  429.     VM_MOV    R2, R1
  430.     VM_FLU?    R2
  431.     VM_JNLs    R2, glob_sym
  432.     VM_MVF    R1, R1
  433.     VM_JMPs    not_sym
  434. LABEL    glob_sym
  435.     VM_MVG    R1, R1         ; Look up symbol in global environment
  436. LABEL    not_sym
  437.     VM_MOV    R2, R1
  438.     VM_CLO?    R2
  439.     VM_JNLs    R2, not_clos
  440.     VM_CLCL    R1, 0
  441. LABEL    not_clos
  442.     VM_NIL    R2
  443.     VM_PRT    R1, R2             ; Print the result (if any)
  444. LABEL    hardexit
  445.     VM_MVI    R1, 0ffh        ; Error code
  446.     VM_HALT    R1
  447.  
  448. ; Reset Code
  449.     VM_SRST             ; debugger entry for forced reset
  450. LABEL    reset_x
  451.     VM_MVG    R1, kill_engine
  452.     VM_CLCL    R1, 0
  453.     VM_CLEARREGS
  454.     VM_MVF    R1, s_top_level
  455.     VM_JNLs    R1, hardexit
  456.     VM_CLCL    R1, 0
  457.     VM_JMPs    reset_x         ; if control returns, reset again
  458.  
  459. ; Error Handler Invocation
  460. LABEL    err_rtn
  461. reg_ctr    = R1
  462. REPT    NUM_REGS-1
  463.     VM_PUSH    reg_ctr
  464. reg_ctr    = reg_ctr+4
  465. ENDM
  466.     VM_MVG    R1, err_name
  467.     VM_CLCL    R1, 0
  468. reg_ctr    = (NUM_REGS-1)*4
  469. REPT    NUM_REGS-1
  470.     VM_POP    reg_ctr
  471. reg_ctr    = reg_ctr-4
  472. ENDM
  473.     VM_EXIT
  474. LABEL    err_default
  475.     VM_DBG
  476. LABEL    ret_default
  477.     VM_EXIT
  478. CODPAGESIZE = $
  479. ENDS    CODPAGE
  480.  
  481.     END
  482.  
  483.